home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / DATADICT / GENTABLE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-15  |  11.5 KB  |  367 lines
  1. unit Gentable;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, DB, DBTables, StdCtrls, Buttons, Grids, DBGrids,
  8.   FileCtrl, IniFiles, ExtCtrls;
  9.  
  10. type
  11.   TBuildTableForm = class(TForm)
  12.     L_SourceDD: TLabel;
  13.     L_DDname: TLabel;
  14.     ProgressWindow: TMemo;
  15.     Label2: TLabel;
  16.     TargetEditBox: TEdit;
  17.     OpenDialog1: TOpenDialog;
  18.     Database1: TDatabase;
  19.     Table1: TTable;
  20.     TargetDataSource: TDataSource;
  21.     TargetQuery: TQuery;
  22.     B_Target: TBitBtn;
  23.     TargetListBox: TListBox;
  24.     Label7: TLabel;
  25.     FileListBox1: TFileListBox;
  26.     MainMenu1: TMainMenu;
  27.     Target1: TMenuItem;
  28.     NewTarget1: TMenuItem;
  29.     OldTarget1: TMenuItem;
  30.     N1: TMenuItem;
  31.     Exit1: TMenuItem;
  32.     Build1: TMenuItem;
  33.     Emptydatabase1: TMenuItem;
  34.     Unitsourcecode1: TMenuItem;
  35.     DictStatus: TMemo;
  36.     Bevel1: TBevel;
  37.     procedure FormActivate(Sender: TObject);
  38.     procedure TargetEditBoxKeyDown(Sender: TObject; var Key: Word;
  39.       Shift: TShiftState);
  40.     procedure TargetListBoxClick(Sender: TObject);
  41.     procedure TargetListBoxExit(Sender: TObject);
  42.     procedure B_TargetClick(Sender: TObject);
  43.     procedure TargetEditBoxClick(Sender: TObject);
  44.     procedure NewTarget1Click(Sender: TObject);
  45.     procedure OldTarget1Click(Sender: TObject);
  46.     procedure Exit1Click(Sender: TObject);
  47.     procedure Emptydatabase1Click(Sender: TObject);
  48.   private
  49.     FiniFile : TiniFile;
  50.     FValidTarget : boolean;
  51.     Procedure ReadIniFile;
  52.     Procedure ChangeIniFile;
  53.     Procedure InitTargetStuff;
  54.     Procedure SetUpTarget(Sender: Tobject; whichone : integer);
  55.     procedure SelectTarget(Sender: TObject);
  56.   public
  57.     { Public declarations }
  58.   end;
  59.  
  60. var
  61.   BuildTableForm: TBuildTableForm;
  62.  
  63. implementation
  64. uses mainmenu, utils, dirdlg, dbutils, mystrng;
  65. {$R *.DFM}
  66.  
  67. const
  68.   gtNoTargetMsg = 'No target.  Click here to create or select.';
  69.  
  70. procedure TBuildTableForm.InitTargetStuff;
  71. begin
  72.   TargetEditBox.text := gtNoTargetMsg;
  73.   FileListBox1.items.clear;
  74. end;
  75. Procedure TBuildTableForm.ReadIniFile;
  76. var tmpstr : string;
  77. begin
  78.   FIniFile := TiniFile.Create(appname+'.ini');
  79.   FiniFile.ReadSection('Targets', targetListBox.items);
  80.   if targetListBox.items.count = 0
  81.     then InitTargetStuff
  82.     else targetEditBox.text := targetListBox.items[0];
  83.   FiniFile.free;
  84. end;
  85.  
  86. Procedure TBuildTableForm.ChangeIniFile;
  87. var i : integer;
  88. begin
  89.   FIniFile := TiniFile.Create(appname+'.ini');
  90.   FiniFile.eraseSection('Targets');
  91.   for i := 0 to targetListBox.Items.count -1 do
  92.     FiniFile.writeString('Targets', targetListBox.items[i], '1');
  93.   FiniFile.free;
  94. end;
  95.  
  96.  
  97. procedure TBuildTableForm.FormActivate(Sender: TObject);
  98. var tmpstr : string;
  99. begin
  100.   L_ddname.caption := main.DDEditBox.text;
  101.   ReadIniFile;
  102.   ProgressWindow.lines.clear;
  103.   DictStatus.lines.clear;
  104.   DictStatus.lines := main.LB_tables.items;
  105.   tmpstr := 'This dictionary contains the following ';
  106.   if main.lb_tables.items.count = 1
  107.     then tmpstr := tmpstr + 'table:'
  108.     else tmpstr := tmpstr + IntToStr(main.lb_tables.items.count)+' tables:';
  109.   DictStatus.lines.insert(0,tmpstr);
  110.   show;
  111. end;
  112.  
  113. procedure TBuildTableForm.Emptydatabase1Click(Sender: TObject);
  114. var tablenum : integer;
  115. begin
  116.   main.TargetDatabase.close;
  117.   main.TargetDatabase.Params.clear;
  118.   main.TargetDatabase.Params.add('PATH='+TargetEditBox.text);
  119.   main.TargetDataBase.open;
  120.   for tablenum := 0 to main.lb_tables.items.count - 1 do begin
  121.     main.targetDataBase.close;
  122.     main.targetTable.free;
  123.     main.targetDataBase.open;
  124.     main.targetTable := ttable.create(self);
  125.     main.targetTable.databasename := main.targetDatabase.databasename;
  126.     main.targetTable.tablename := main.lb_tables.items[tablenum];
  127.     main.TargetTable.TableType := ttDbase;
  128.     if DictCtrl.BuildEmptyTable(main.targetTable, main.lb_tables.items[tablenum])
  129.       then messagedlg('OK', mtinformation, [mbOK],0)
  130.       else messagedlg('not ok', mtinformation, [mbOK],0);
  131.     end;
  132. end;
  133.  
  134. (*
  135. var tables, fields : tstringlist;
  136.     tablenum : integer;
  137.     thistable : string;
  138.     tablefound : boolean;
  139.     fieldname : string[10];
  140.     fieldtype : tFieldType;
  141.     fieldlen  : integer;
  142.     indexed   : boolean;
  143. begin
  144.   main.SourceDataBase.close;
  145.   main.SourceDatabase.Params.clear;
  146.   main.SourceDatabase.Params.Add('PATH='+main.DDPathName);
  147.   main.SourceDatabase.open;
  148.   progressWindow.lines.add('Dictionary open');
  149.   main.TargetDatabase.close;
  150.   main.TargetDatabase.Params.clear;
  151.   main.TargetDatabase.Params.add('PATH='+TargetEditBox.text);
  152.   main.TargetDataBase.open;
  153.   with Main.DictQuery do begin
  154.     databasename := main.SourceDataBase.databasename;
  155.     close;
  156.     sql.clear;
  157.     thistable := 'SELECT * FROM '+main.DDTablename+' where TABLE_NAME = :tableid';
  158.     sql.add(thistable);
  159.     prepare;
  160.     {Iterate through the tables, build each database}
  161.     for tablenum := 0 to main.lb_tables.items.count - 1 do begin
  162.        main.targetTable := ttable.create(self);
  163.        main.targetTable.databasename := main.targetDatabase.databasename;
  164.        main.targetTable.tablename := main.lb_tables.items[tablenum];
  165.        main.TargetTable.TableType := ttDbase;
  166.        progressWindow.lines.add('Building table '+main.lb_tables.items[tablenum]);
  167.        main.TargetTable.close;
  168.        close;
  169.        ParamByName('tableid').asString := main.lb_tables.items[tablenum];
  170.        open;
  171.        first;
  172.        with main.TargetTable.FieldDefs do begin
  173.          clear;
  174.          while not EOF do begin
  175.            fieldname := findfield('FIELD_NAME').text;
  176.            fieldlen  := findfield('FIELD_LEN').asInteger;
  177.            for fieldtype := ftunknown to ftgraphic do
  178.              if upper(findfield('FIELD_TYPE').text) = upper(FieldTypeStr[fieldtype])
  179.                  then break;
  180.            case fieldtype of
  181.               ftSmallint  ,
  182.               ftInteger   ,
  183.               ftWord      ,
  184.               ftBoolean   ,
  185.               ftFloat     ,
  186.               ftCurrency  ,
  187.               ftBCD       ,
  188.               ftDate      ,
  189.               ftTime      ,
  190.               ftDateTime  : FieldLen := 0;
  191.               end; {Case}
  192.            indexed := findfield('FIELD_IDX').asBoolean;
  193.            add(fieldname, fieldtype, fieldlen, indexed);
  194.            if indexed
  195.              then main.targettable.IndexDefs.add(fieldname, fieldname, [ixPrimary, ixUnique]);
  196.            next;
  197.            end; { with while DictQuery not EOF}
  198.          end;   { with targettable.fielddefs}
  199.       main.TargetTable.CreateTable;
  200.     end;   { for tablenum through tables stringlist}
  201.     progressWindow.lines.add('Done.');
  202.   end; {with main.DictQuery}
  203.   main.DictQuery.close;
  204.   main.sourcedatabase.close;
  205.   main.targetDatabase.close;
  206. end;
  207. *)
  208.  
  209. procedure TbuildTableForm.TargetEditBoxKeyDown(Sender: TObject; var Key: Word;
  210.   Shift: TShiftState);
  211. begin
  212.   if key = VK_RETURN
  213.     then SelectTarget(Sender);
  214. end;
  215.  
  216. Procedure TbuildTableForm.SetUpTarget(Sender: Tobject; whichone : integer);
  217. var Dir: string;
  218.     i, doserr : integer;
  219.     found : boolean;
  220. begin
  221.   ProgressWindow.clear;
  222.   if length(targetListBox.items[whichone]) = 0
  223.     then begin
  224.       fValidTarget := false;
  225.       initTargetStuff;
  226.       exit;
  227.       end;
  228.   dir := addBackSlash(TargetListBox.items[whichone]);
  229.   if DirectoryExists(dir)
  230.     then begin
  231.        found := false;
  232.        for i := 0 to main.lb_tables.items.count -1 do
  233.          if fileexists(dir+main.lb_tables.items[i]+'.dbf')
  234.            then begin
  235.              found := true;
  236.              break;
  237.              end;
  238.        if found {we found one of the tables in the current dictionary}
  239.          then begin
  240.             ProgressWindow.lines.add('Table '+main.lb_tables.items[i]+' exists in ');
  241.             ProgressWindow.lines.add(dir+'.');
  242.             ProgressWindow.lines.add('tables will be overwritten upon generation');
  243.             TargetListBox.items.exchange(0,whichone);
  244.             TargetEditBox.text := TargetListBox.items[0];
  245.             FValidTarget := true;
  246.             end
  247.          else begin  {dir exists and is ready}
  248.             ProgressWindow.lines.add('Target ' +dir+' ready.');
  249.             TargetListBox.items.exchange(0,whichone);
  250.             TargetEditBox.text := TargetListBox.items[0];
  251.             FValidTarget := true;
  252.             end;
  253.        end  {of if directory exists}
  254.      else   {dir didn't exist}
  255.        if fileexists(stripBackSlash(dir))
  256.          then begin
  257.             ProgressWindow.lines.add('Cannot create target directory');
  258.             ProgressWindow.lines.add(dir);
  259.             ProgressWindow.lines.add('Because it is an existing file.');
  260.             TargetEditBox.text := '';
  261.             FValidTarget := False;
  262.             end
  263.          else begin
  264.             {$I-}
  265.             MkDir(stripBackSlash(dir));
  266.             {$I+}
  267.             Doserr := ioresult;
  268.             if DosErr = 0
  269.               then begin
  270.                 TargetEditBox.text := dir;
  271.                 FValidTarget := true;
  272.                 ProgressWindow.lines.add('Created target directory '+dir);
  273.                 end
  274.               else begin
  275.                 FValidTarget := false;
  276.                 ProgressWindow.lines.add('Could not create target directory');
  277.                 ProgressWindow.lines.add(dir);
  278.                 ProgressWindow.lines.add('DOS error '+ intToStr(doserr));
  279.                 end;
  280.             end;
  281. end;
  282.  
  283.  
  284. procedure TbuildTableForm.SelectTarget(Sender: TObject);
  285.   var i : integer;
  286.     found : boolean;
  287.     tmpstr : string;
  288. begin
  289.   with TargetListBox do
  290.     begin
  291.       found := false;
  292.       for i := 0 to items.count -1 do
  293.         if TargetEditBox.text = items[i]
  294.           then begin
  295.             found := true;
  296.             break;
  297.             end;
  298.       if found
  299.         then SetUpTarget(sender, i)
  300.         else begin
  301.           items.add(TargetEditBox.text);
  302.           SetUpTarget(sender, items.count -1);
  303.           end;
  304.       hide;
  305.     end;
  306.  if fValidTarget
  307.    then begin
  308.      i := Ord(upcase(targetEditBox.text[1])) - ord('A')+1;
  309.      ProgressWindow.lines.add('Disk Space available: '+ IKMGB(diskfree(i)));
  310.      FileListBox1.directory := TargetEditBox.text;
  311.      end
  312.    else InitTargetStuff;
  313. end;
  314.  
  315. procedure TbuildTableForm.TargetListBoxClick(Sender: TObject);
  316. begin
  317.   TargetEditBox.text := TargetListBox.items[TargetListBox.itemindex];
  318.   SelectTarget(sender);
  319. end;
  320.  
  321. procedure TbuildTableForm.B_TargetClick(Sender: TObject);
  322. begin
  323.   TargetListBox.show;
  324. end;
  325.  
  326. procedure TbuildTableForm.TargetListBoxExit(Sender: TObject);
  327. begin
  328.   TargetListBox.Hide;
  329. end;
  330.  
  331. procedure TBuildTableForm.TargetEditBoxClick(Sender: TObject);
  332. begin
  333.   if TargetEditBox.text = gtNoTargetMsg
  334.     then TargetEditBox.text := '';
  335.   TargetEditBox.text := ChooseDirectory('Select Target Directory', TargetEditBox.text);
  336.   SelectTarget(sender);
  337.   targetListBox.hide;
  338. end;
  339.  
  340. procedure TBuildTableForm.NewTarget1Click(Sender: TObject);
  341. begin
  342.   if TargetEditBox.text = gtNoTargetMsg
  343.     then TargetEditBox.text := '';
  344.   TargetEditBox.text := ChooseDirectory('Select Target Directory', TargetEditBox.text);
  345.   SelectTarget(sender);
  346.   targetListBox.hide;
  347. {  if TargetEditBox.text = gtNoTargetMsg
  348.     then tgtDirDlg.l_directory.caption := ''
  349.     else tgtDirDlg.l_directory.caption := TargetEditBox.text;
  350.   if tgtDirDlg.showmodal = mrOK
  351.     then TargetEditBox.text := tgtDirDlg.l_directory.caption;
  352.   SelectTarget(sender);}
  353. end;
  354.  
  355. procedure TBuildTableForm.OldTarget1Click(Sender: TObject);
  356. begin
  357.     TargetListBox.show;
  358. end;
  359.  
  360. procedure TBuildTableForm.Exit1Click(Sender: TObject);
  361. begin
  362.   close;
  363. end;
  364.  
  365.  
  366. end.
  367.